;;;; cocoa-renderer.lisp
;;;;
;;;; Utilities and other useful stuff for doing OpenGL in CCL.
;;;;

(in-package :dreaming-tree)


;;;
;;; OpenGL View and (really naive) Animation
;;;

(defclass renderer-controller (ns:ns-object)
  ((canvas :foreign-type :id :accessor window-canvas)
   (thread-run-loop :foreign-type :id :accessor window-thread-run-loop)
   (animationTimer :foreign-type :id :accessor window-animation-timer)
   (nib-objects :accessor nib-objects :initform nil))
  (:metaclass ns:+ns-object))

(objc:defmethod (#/windowWillClose: :void) ((controller renderer-controller) notification)
  (declare (ignore notification))
  (log5:log-for (trace) "windowWillClose notification received by ~A." controller)
  (when (and (slot-boundp controller 'canvas)
             (window-canvas controller))
    (scene-cleanup (window-canvas controller))
    (stop-animation (window-canvas controller))))

(objc:defmethod (#/animate: :void) ((controller renderer-controller) (sender :id))
  (declare (ignore sender))
  (start-animation controller))

(objc:defmethod (#/pause: :void) ((controller renderer-controller) (sender :id))
  (declare (ignore sender))
  (stop-animation controller))

(defparameter *animation-timer-delay* 0.05d0)

(defmethod start-animation ((window renderer-controller))
  (log5:log-for (trace) "Starting animation timer...")
  (let* ((runloop (#/currentRunLoop ns:ns-run-loop)))
    (setf (window-thread-run-loop window) runloop)
    (setf (window-animation-timer window)
          (make-instance 'ns:ns-timer
			 :with-fire-date (#/distantPast ns:ns-date)
			 :interval *animation-timer-delay*
			 :target (window-canvas window)
			 :selector (ccl::@selector #/doAnimation:)
			 :user-info (ccl:%null-ptr)
			 :repeats t))
    (ccl::with-autorelease-pool
      (#/addTimer:forMode: runloop (window-animation-timer window) #$NSDefaultRunLoopMode)
      (#/run (the ns:ns-run-loop runloop))))
  (log5:log-for (trace) "Animation timer started."))

(defmethod stop-animation ((window renderer-controller))
  (log5:log-for (trace) "Stopping animation timer..")
  (when (not (ccl:%null-ptr-p (window-animation-timer window)))
    (#/invalidate (window-animation-timer window)))
  (log5:log-for (trace) "Stopping animation..")
  (let* ((cfrunloop (#/getCFRunLoop (#/currentRunLoop ns:ns-run-loop))))
    (#_CFRunLoopStop cfrunloop))
  (ccl:signal-semaphore (window-close-ack (window-canvas window))))

(defmethod initialize-instance :after ((window renderer-controller) &key &allow-other-keys)
  (let ((objects (iu:load-nibfile (truename "dt:SimpleRenderer.nib") :nib-owner window :retain-top-objs t)))
    (setf (nib-objects window) objects)
    (format t "Toplevel objects are ~A.~%" objects)
    (ccl:terminate-when-unreachable window)))

(defmethod ccl:terminate ((window renderer-controller))
  (dolist (obj (nib-objects window))
    (unless (eql obj (ccl:%null-ptr))
      (#/release obj))))

(defclass cocoa-renderer (ns:ns-opengl-view renderer)
  ((camera :accessor camera :initarg :camera :initform (make-instance 'action-camera))
   (close-ack :accessor window-close-ack :initform (ccl:make-semaphore)))
  (:metaclass ns:+ns-object))

(objc:defmethod (#/prepareOpenGL :void) ((view cocoa-renderer))
  (init view)
  (#/reshape view))

(objc:defmethod (#/reshape :void) ((view cocoa-renderer))
  (let* ((frame (#/frame view))
         (width (ns:ns-rect-width frame))
         (height (ns:ns-rect-height frame)))
    (gl:viewport 0 0 (truncate width) (truncate height))
    ;; Update camera perspective...
    (setf (camera-aspect (camera view)) (/ width height))))

(objc:defmethod (#/doAnimation: :void)
    ((self cocoa-renderer) (sender :id))
  (declare (ignore sender))
  (setf (current-timestep self) (delta-time self))
  (#/setNeedsDisplay: self t))

(objc:defmethod (#/drawRect: :void) ((view cocoa-renderer) (rect :<NSR>ect))
  (log5:log-for (trace) "In drawRect:")
  (ccl:with-macptrs ((context (#/openGLContext view)))
    (when context
      (clear-background view)
      (draw-scene view (visible-set (scene-culler view)))
      (#/flushBuffer context)))
  (#/clearCurrentContext ns:ns-opengl-context))

(defmethod scene-cleanup ((view cocoa-renderer))
  (log5:log-for (trace) "Scene cleanup called.")
  nil)

(defmethod init ((canvas cocoa-renderer))
  (determine-capabilities canvas)
  (setf (current-time (#_CFAbsoluteTimeGetCurrent)))
  (when (null (scene-culler canvas))
    (setf (scene-culler canvas) (make-instance 'culler)))
  (gl:shade-model :smooth)
  (gl:clear-color 0.0 0.0 0.0 0.0)
  (gl:clear-depth 1.0d0)
  (gl:hint :perspective-correction-hint :nicest)
  (#/setNeedsDisplay: canvas t))
  
(defmethod clear-background ((self cocoa-renderer))
  (log5:log-for (trace) "Clearing gl context background.")
  (gl:clear :color-buffer-bit :depth-buffer-bit))

(defmethod draw-scene ((canvas cocoa-renderer) objects)
  (declare (ignore objects))
  (log5:log-for (trace) "Drawing scene in a basic-gl-renderer.")
  (gl:load-identity)
  ;(draw (camera canvas))
  ;(#_glLoadIdentity)
  ;(#_glTranslatef -1.0 0.0 1.0)
  (gl:with-primitive :polygon
    (gl:color 1.0 0.0 0.0)
    (gl:vertex 0.0 1.0 0.0) 
    (gl:color 0.0 1.0 0.0)
    (gl:vertex -1.0 -1.0 0.0) 
    (gl:color  0.0 0.0 1.0)
    (gl:vertex 1.0 -1.0 0.0)))

;;; Textures

(defstruct gltexture
  name
  width
  height)

(defclass texture ()
  ((source :reader source :initarg :source :initform nil)
   (glview :reader glview :initarg :glview :initform nil)
   (binding :accessor binding :initarg :binding :initform 0)
   (width :accessor width :initarg :width :initform 0.0)
   (height :accessor height :initarg :height :initform 0.0)
   (mag-filter :accessor mag-filter :initarg :mag-filter :initform #$GL_LINEAR)
   (min-filter :accessor min-filter :initarg :min-filter :initform #$GL_LINEAR)))

(defun cf-url-create-with-string (string)
  (#_CFURLCreateWithString #&kCFAllocatorDefault 
                           (ccl::%make-nsstring string)
                           (ccl:%null-ptr)))

(defun make-gltexture-from-url-string (url &optional (tex-name 0))
  ;;; Copied verbatim from Apple's OpenGL Programming Guide
  (let* ((source (#_CGImageSourceCreateWithURL (cf-url-create-with-string url) (ccl:%null-ptr)))
         (image (#_CGImageSourceCreateImageAtIndex source 0 (ccl:%null-ptr)))
         (width (#_CGImageGetWidth image))
         (height (#_CGImageGetHeight image))
         (rect (ns:make-ns-rect 0 0 width height))
         (data (#_calloc (* width 4) height))
         (space (#_CGColorSpaceCreateDeviceRGB))
         (bitmap-context (#_CGBitmapContextCreate data width height 8 (* width 4)
                                                  space
                                                  #.(logior #$kCGBitmapByteOrder32Host
                                                            #$kCGImageAlphaPremultipliedFirst))))
    (#_CGContextDrawImage bitmap-context rect image)
    (#_CGContextRelease bitmap-context)
    (#_glPixelStorei #$GL_UNPACK_ROW_LENGTH width)
    (#_glPixelStorei #$GL_UNPACK_ALIGNMENT 1)
    (when (= tex-name 0)
      (ccl:rlet ((uid :<GL>uint))
        (#_glGenTextures 1 uid)
        (setf tex-name (ccl:%get-unsigned-word uid))))
    (#_glBindTexture #$GL_TEXTURE_RECTANGLE_ARB tex-name)
    ;(#_glBindTexture #$GL_TEXTURE_RECTANGLE_ARB #$GL_TEXTURE_STORAGE_HINT_APPLE #$GL_STORAGE_SHARED_APPLE)
    (#_glTexParameteri #$GL_TEXTURE_RECTANGLE_ARB #$GL_TEXTURE_MIN_FILTER #$GL_LINEAR)
    (#_glTexImage2D #$GL_TEXTURE_RECTANGLE_ARB 0 #$GL_RGBA8 width height
                    0 #$GL_BGRA_EXT #$GL_UNSIGNED_INT_8_8_8_8_REV data)
    (#_free data)
    (make-gltexture :name tex-name :width (coerce width 'float) :height (coerce height 'float))))

(defun %gl-texture-image-from-source (source mag-filter min-filter &optional (tex-name 0))
  ;;; Copied verbatim from Apple's OpenGL Programming Guide
  (let* ((source (#_CGImageSourceCreateWithURL (cf-url-create-with-string source) (ccl:%null-ptr)))
         (image (#_CGImageSourceCreateImageAtIndex source 0 (ccl:%null-ptr)))
         (width (#_CGImageGetWidth image))
         (height (#_CGImageGetHeight image))
         (rect (ns:make-ns-rect 0 0 width height))
         (data (#_calloc (* width 4) height))
         (space (#_CGColorSpaceCreateDeviceRGB))
         (bitmap-context (#_CGBitmapContextCreate data width height 8 (* width 4)
                                                  space
                                                  #.(logior #$kCGBitmapByteOrder32Host
                                                            #$kCGImageAlphaPremultipliedFirst))))
    (if (or (null source)
            (ccl:%null-ptr-p source))
      (warn "Could not find image data at URL ~A." source)) 
    (#_CGContextDrawImage bitmap-context rect image)
    (#_CGContextRelease bitmap-context)
    (#_glPixelStorei #$GL_UNPACK_ROW_LENGTH width)
    (#_glPixelStorei #$GL_UNPACK_ALIGNMENT 1)
    (when (= tex-name 0)
      (ccl:rlet ((uid :<GL>uint))
        (#_glGenTextures 1 uid)
        (setf tex-name (ccl:%get-unsigned-word uid))))
    (#_glBindTexture #$GL_TEXTURE_RECTANGLE_ARB tex-name)
    (#_glTexParameteri #$GL_TEXTURE_RECTANGLE_ARB #$GL_TEXTURE_MAG_FILTER mag-filter)
    (#_glTexParameteri #$GL_TEXTURE_RECTANGLE_ARB #$GL_TEXTURE_MIN_FILTER min-filter)
    (#_glTexImage2D #$GL_TEXTURE_RECTANGLE_ARB 0 #$GL_RGBA8 width height
                    0 #$GL_BGRA_EXT #$GL_UNSIGNED_INT_8_8_8_8_REV data)
    (#_free data)
    (values tex-name (coerce width 'float) (coerce height 'float))))

(defmethod load-texture ((tex texture))
  (when (glview tex)
    (with-slots (glview source binding width height min-filter mag-filter) tex
      (multiple-value-bind (name w h)
                           (%gl-texture-image-from-source source mag-filter min-filter)
        (setf binding name
              width w
              height h)))))

;;;; Drawing Geometric Primitives ;;;;

;; Use aux:with-gensyms
(defmacro with-world-transformation (spatial &body body)
  `(let ((m (transform ,spatial)))
     (with-slots (r s b) m
       (gl:with-pushed-matrix
	 (gl:translate (x b) (y b) (z b))
	 (gl:scale (x s) (y s) (z s))
	 (multiple-value-bind (angle dir) (quat-to-axis-angle r)
	   (gl:rotate (lib.gl::rad-to-deg angle) (x dir) (y dir) (z dir)))
	 ,@body))))

;; Not much for the moment, but will eventually involve the use of buffer arrays.
(defmacro with-i-buffer (geometry &body body)
  (declare (ignore geometry))
  `(progn
     ,@body))

;; Likewise, not much until I understand better how I want to implement render states.
(defmacro with-global-states (geometry &body body)
  (declare (ignore geometry))
  `(progn
     ,@body))

(defmethod draw ((g geometry))
  ;; Set global state?
  (with-render-states-active (global-states g)
    (with-world-transformation g
      (with-i-buffer g
	(with-slots (lights effects) g
	  (let ((primary-effect-p t))
	    (if (and (null lights) (null effects))
		(draw-primitives g)
		(progn
		  (when (lights g)
		    (dolist (le (lights g))
		      (apply-effect g le)
		      (setq primary-effect-p nil)))
		  (dolist (e (effects g))
		    (apply-effect g e)
		    (setq primary-effect-p nil))))))))))

(defmethod apply-effect ((g geometry) (e effect))
  (enable-texture (texture e))
  (draw-primitives g)
  (disable-texture (texture e)))


(defmethod draw-primitives ((obj trimesh))
  (ccl:rlet ((zoffset :<GL>uint))
    (setf (ccl:%get-unsigned-byte zoffset) 0)
    (with-slots (v vid c cid n nid i iid tc tcid) obj
      ;; Draw vertices
      (when (or (slot-boundp obj 'v) vid)
	(format t "About to draw vertices.~%")
	(gl:enable-client-state :vertex-array)
	(if vid
	    (progn
	      (gl:bind-buffer :array-buffer vid)
	      (%gl:vertex-pointer 3 (map-lisp-type-to-gl (element-type v)) 0 zoffset))
	    (%gl:vertex-pointer 3 (map-lisp-type-to-gl (element-type v)) 0 (get-pointer v))))
      ;; (when (or (slot-boundp obj 'c) cid)
      ;; 	(format t "About to draw colors.~%")
      ;; 	(glEnableClientState GL_COLOR_ARRAY)
      ;; 	(if cid
      ;; 	    (progn
      ;; 	      (glBindBufferARB GL_ARRAY_BUFFER_ARB cid)
      ;; 	      (glColorPointer 3 (map-lisp-type-to-gl (element-type c)) 0 zoffset))
      ;; 	    (glColorPointer 3 (map-lisp-type-to-gl (element-type c)) 0 (get-pointer c))))
      ;; (when (or (slot-boundp obj 'n) nid)
      ;; 	(format t "About to draw normals.~%")
      ;; 	(glEnableClientState GL_NORMAL_ARRAY)
      ;; 	(if nid
      ;; 	    (progn
      ;; 	      (glBindBufferARB GL_ARRAY_BUFFER_ARB nid)
      ;; 	      (glNormalPointer (map-lisp-type-to-gl (element-type n)) 0 zoffset))
      ;; 	    (glNormalPointer (map-lisp-type-to-gl (element-type n)) 0 (get-pointer n))))
      ;; (when (or (slot-boundp obj 'tc) tcid)
      ;; 	(format t "About to draw texture coordinates.~%")
      ;; 	(glEnableClientState GL_TEXTURE_COORD_ARRAY)
      ;; 	(if tcid
      ;; 	    (progn
      ;; 	      (glBindBufferARB GL_ARRAY_BUFFER_ARB nid)
      ;; 	      (glTexCoordPointer 3 (map-lisp-type-to-gl (element-type tc)) 0 zoffset))
      ;; 	    (glTexCoordPointer 2 (map-lisp-type-to-gl (element-type tc)) 0 (get-pointer tc))))
      (format t "About to put it al together!~%")
      ;; (if iid
      ;; 	  (progn
      ;; 	    (gl:bind-buffer :element-array-buffer iid)
      ;; 	    (gl:draw-elements :triangles (element-count i) :unsigned-int zoffset))
      ;; 	  (gl:draw-elements :triangles (element-count i) :unsigned-int (get-pointer i)))
      ;;(glDrawArrays GL_POINTS 0 (lib.gl::element-count v))
      (gl:disable-client-state :texture-coord-array)
      (gl:disable-client-state :normal-array)
      (gl:disable-client-state :color-array)
      (gl:disable-client-state :vertex-array))))

;;;;

(defun test-loading-nib ()
  (iu:load-nibfile (truename "dt:SimpleRenderer.nib")))